summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/AutoMerge.hs25
-rw-r--r--Annex/Content.hs85
-rw-r--r--Annex/Ingest.hs24
-rw-r--r--Annex/Link.hs16
-rw-r--r--Assistant/Threads/Committer.hs4
-rw-r--r--Command/Fix.hs6
-rw-r--r--Command/Fsck.hs7
-rw-r--r--Command/Lock.hs4
-rw-r--r--Command/ReKey.hs9
-rw-r--r--Command/Unlock.hs12
-rw-r--r--Upgrade/V5.hs2
-rw-r--r--debian/changelog1
12 files changed, 128 insertions, 67 deletions
diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs
index 074e955d7..e6f2be552 100644
--- a/Annex/AutoMerge.hs
+++ b/Annex/AutoMerge.hs
@@ -23,7 +23,7 @@ import qualified Git.Merge
import qualified Git.Ref
import qualified Git
import qualified Git.Branch
-import Git.Types (BlobType(..))
+import Git.Types (BlobType(..), fromBlobType)
import Git.FilePath
import Config
import Annex.ReplaceFile
@@ -31,6 +31,7 @@ import Annex.VariantFile
import qualified Database.Keys
import Annex.InodeSentinal
import Utility.InodeCache
+import Utility.FileMode
import qualified Data.Set as S
import qualified Data.Map as M
@@ -152,12 +153,12 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
-- In either case, keep original filename.
if islocked LsFiles.valUs && islocked LsFiles.valThem
then makesymlink keyUs file
- else makepointer keyUs file
+ else makepointer keyUs file (combinedmodes)
return ([keyUs, keyThem], Just file)
-- Our side is annexed file, other side is not.
(Just keyUs, Nothing) -> resolveby [keyUs] $ do
graftin them file LsFiles.valThem LsFiles.valThem LsFiles.valUs
- makeannexlink keyUs LsFiles.valUs
+ makeannexlink keyUs LsFiles.valUs
-- Our side is not annexed file, other side is.
(Nothing, Just keyThem) -> resolveby [keyThem] $ do
graftin us file LsFiles.valUs LsFiles.valUs LsFiles.valThem
@@ -174,11 +175,19 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
islocked select = select (LsFiles.unmergedBlobType u) == Just SymlinkBlob
+ combinedmodes = case catMaybes [ourmode, theirmode] of
+ [] -> Nothing
+ l -> Just (combineModes l)
+ where
+ ourmode = fromBlobType <$> LsFiles.valUs (LsFiles.unmergedBlobType u)
+ theirmode = fromBlobType <$> LsFiles.valThem (LsFiles.unmergedBlobType u)
+
makeannexlink key select
| islocked select = makesymlink key dest
- | otherwise = makepointer key dest
+ | otherwise = makepointer key dest destmode
where
dest = variantFile file key
+ destmode = fromBlobType <$> select (LsFiles.unmergedBlobType u)
stagefile :: FilePath -> Annex FilePath
stagefile f
@@ -194,16 +203,16 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
replacewithsymlink dest link = withworktree dest $ \f ->
replaceFile f $ makeGitLink link
- makepointer key dest = do
+ makepointer key dest destmode = do
unless inoverlay $
unlessM (reuseOldFile unstagedmap key file dest) $ do
- r <- linkFromAnnex key dest
+ r <- linkFromAnnex key dest destmode
case r of
LinkAnnexFailed -> liftIO $
- writeFile dest (formatPointer key)
+ writePointerFile dest key destmode
_ -> noop
dest' <- stagefile dest
- stagePointerFile dest' =<< hashPointerFile key
+ stagePointerFile dest' destmode =<< hashPointerFile key
unless inoverlay $
Database.Keys.addAssociatedFile key
=<< inRepo (toTopFilePath dest)
diff --git a/Annex/Content.hs b/Annex/Content.hs
index a17098ad7..c1d6031a7 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -509,10 +509,11 @@ populatePointerFile :: Key -> FilePath -> FilePath -> Annex ()
populatePointerFile k obj f = go =<< liftIO (isPointerFile f)
where
go (Just k') | k == k' = do
+ destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f
liftIO $ nukeFile f
- ifM (linkOrCopy k obj f)
+ ifM (linkOrCopy k obj f destmode)
( thawContent f
- , liftIO $ writeFile f (formatPointer k)
+ , liftIO $ writePointerFile f k destmode
)
go _ = return ()
@@ -523,14 +524,14 @@ data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
linkToAnnex :: Key -> FilePath -> Maybe InodeCache -> Annex LinkAnnexResult
linkToAnnex key src srcic = do
dest <- calcRepo (gitAnnexLocation key)
- modifyContent dest $ linkAnnex To key src srcic dest
+ modifyContent dest $ linkAnnex To key src srcic dest Nothing
{- Makes a destination file be a link or copy from the annex object. -}
-linkFromAnnex :: Key -> FilePath -> Annex LinkAnnexResult
-linkFromAnnex key dest = do
+linkFromAnnex :: Key -> FilePath -> Maybe FileMode -> Annex LinkAnnexResult
+linkFromAnnex key dest destmode = do
src <- calcRepo (gitAnnexLocation key)
srcic <- withTSDelta (liftIO . genInodeCache src)
- linkAnnex From key src srcic dest
+ linkAnnex From key src srcic dest destmode
data FromTo = From | To
@@ -542,10 +543,12 @@ data FromTo = From | To
- the annex object too. So, adding an object to the annex this
- way can prevent losing the content if the source file
- is deleted, but does not guard against modifications.
+ -
+ - Nothing is done if the destination file already exists.
-}
-linkAnnex :: FromTo -> Key -> FilePath -> Maybe InodeCache -> FilePath -> Annex LinkAnnexResult
-linkAnnex _ _ _ Nothing _ = return LinkAnnexFailed
-linkAnnex fromto key src (Just srcic) dest = do
+linkAnnex :: FromTo -> Key -> FilePath -> Maybe InodeCache -> FilePath -> Maybe FileMode -> Annex LinkAnnexResult
+linkAnnex _ _ _ Nothing _ _ = return LinkAnnexFailed
+linkAnnex fromto key src (Just srcic) dest destmode = do
mdestic <- withTSDelta (liftIO . genInodeCache dest)
case mdestic of
Just destic -> do
@@ -554,7 +557,7 @@ linkAnnex fromto key src (Just srcic) dest = do
then Database.Keys.addInodeCaches key [srcic, destic]
else Database.Keys.addInodeCaches key [srcic]
return LinkAnnexNoop
- Nothing -> ifM (linkOrCopy key src dest)
+ Nothing -> ifM (linkOrCopy key src dest destmode)
( do
thawContent $ case fromto of
From -> dest
@@ -578,27 +581,38 @@ linkAnnex fromto key src (Just srcic) dest = do
liftIO $ nukeFile dest
failed
-{- Hard links or copies src to dest. Only uses a hard link when annex.thin
- - is enabled and when src is not already hardlinked to elsewhere.
+{- Hard links or copies src to dest, which must not already exists.
+ -
+ - Only uses a hard link when annex.thin is enabled and when src is
+ - not already hardlinked to elsewhere.
+ -
- Checks disk reserve before copying against the size of the key,
- - and will fail if not enough space, or if the dest file already exists. -}
-linkOrCopy :: Key -> FilePath -> FilePath -> Annex Bool
+ - and will fail if not enough space, or if the dest file already exists.
+ -
+ - The FileMode, if provided, influences the mode of the dest file.
+ - In particular, if it has an execute bit set, the dest file's
+ - execute bit will be set. The mode is not fully copied over because
+ - git doesn't support file modes beyond execute.
+ -}
+linkOrCopy :: Key -> FilePath -> FilePath -> Maybe FileMode -> Annex Bool
linkOrCopy = linkOrCopy' (annexThin <$> Annex.getGitConfig)
-linkOrCopy' :: Annex Bool -> Key -> FilePath -> FilePath -> Annex Bool
-linkOrCopy' canhardlink key src dest = catchBoolIO $
- ifM canhardlink
- ( hardlink
- , copy =<< getstat
- )
+linkOrCopy' :: Annex Bool -> Key -> FilePath -> FilePath -> Maybe FileMode -> Annex Bool
+linkOrCopy' canhardlink key src dest destmode
+ | maybe False isExecutable destmode = copy =<< getstat
+ | otherwise = catchBoolIO $
+ ifM canhardlink
+ ( hardlink
+ , copy =<< getstat
+ )
where
hardlink = do
s <- getstat
if linkCount s > 1
then copy s
- else liftIO (createLink src dest >> return True)
+ else liftIO (createLink src dest >> preserveGitMode dest destmode >> return True)
`catchIO` const (copy s)
- copy = checkedCopyFile' key src dest
+ copy = checkedCopyFile' key src dest destmode
getstat = liftIO $ getFileStatus src
{- Removes the annex object file for a key. Lowlevel. -}
@@ -610,18 +624,30 @@ unlinkAnnex key = do
liftIO $ nukeFile obj
{- Checks disk space before copying. -}
-checkedCopyFile :: Key -> FilePath -> FilePath -> Annex Bool
-checkedCopyFile key src dest = catchBoolIO $
- checkedCopyFile' key src dest
+checkedCopyFile :: Key -> FilePath -> FilePath -> Maybe FileMode -> Annex Bool
+checkedCopyFile key src dest destmode = catchBoolIO $
+ checkedCopyFile' key src dest destmode
=<< liftIO (getFileStatus src)
-checkedCopyFile' :: Key -> FilePath -> FilePath -> FileStatus -> Annex Bool
-checkedCopyFile' key src dest s = catchBoolIO $
+checkedCopyFile' :: Key -> FilePath -> FilePath -> Maybe FileMode -> FileStatus -> Annex Bool
+checkedCopyFile' key src dest destmode s = catchBoolIO $
ifM (checkDiskSpace' (fromIntegral $ fileSize s) (Just $ takeDirectory dest) key 0 True)
- ( liftIO $ copyFileExternal CopyAllMetaData src dest
+ ( liftIO $
+ copyFileExternal CopyAllMetaData src dest
+ <&&> preserveGitMode dest destmode
, return False
)
+preserveGitMode :: FilePath -> Maybe FileMode -> IO Bool
+preserveGitMode f (Just mode)
+ | isExecutable mode = catchBoolIO $ do
+ modifyFileMode f $ addModes executeModes
+ return True
+ | otherwise = catchBoolIO $ do
+ modifyFileMode f $ removeModes executeModes
+ return True
+preserveGitMode _ _ = return True
+
{- Runs an action to transfer an object's content.
-
- In some cases, it's possible for the file to change as it's being sent.
@@ -729,9 +755,10 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect
Direct.removeInodeCache key
resetpointer file = ifM (isUnmodified key file)
( do
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
secureErase file
liftIO $ nukeFile file
- liftIO $ writeFile file (formatPointer key)
+ liftIO $ writePointerFile file key mode
-- Can't delete the pointer file.
-- If it was a hard link to the annex object,
-- that object might have been frozen as part of the
diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs
index 1bf1db146..95bbff496 100644
--- a/Annex/Ingest.hs
+++ b/Annex/Ingest.hs
@@ -130,7 +130,9 @@ ingestAdd ld@(Just (LockedDown cfg source)) = do
( do
l <- calcRepo $ gitAnnexLink f k
stageSymlink f =<< hashSymlink l
- , stagePointerFile f =<< hashPointerFile k
+ , do
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (contentLocation source)
+ stagePointerFile f mode =<< hashPointerFile k
)
return (Just k)
@@ -344,15 +346,19 @@ cachedCurrentBranch = maybe cache (return . Just)
addAnnexedFile :: FilePath -> Key -> Maybe FilePath -> Annex ()
addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
( do
- stagePointerFile file =<< hashPointerFile key
+ mode <- maybe
+ (pure Nothing)
+ (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> getFileStatus tmp)
+ mtmp
+ stagePointerFile file mode =<< hashPointerFile key
Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
case mtmp of
Just tmp -> do
moveAnnex key tmp
- linkunlocked
+ linkunlocked mode
Nothing -> ifM (inAnnex key)
- ( linkunlocked
- , writepointer
+ ( linkunlocked mode
+ , liftIO $ writePointerFile file key mode
)
, do
addLink file key Nothing
@@ -368,9 +374,9 @@ addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
Nothing -> return ()
)
where
- writepointer = liftIO $ writeFile file (formatPointer key)
- linkunlocked = do
- r <- linkFromAnnex key file
+ linkunlocked mode = do
+ r <- linkFromAnnex key file mode
case r of
- LinkAnnexFailed -> writepointer
+ LinkAnnexFailed -> liftIO $
+ writePointerFile file key mode
_ -> return ()
diff --git a/Annex/Link.hs b/Annex/Link.hs
index 44c567837..af20ae30d 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -23,6 +23,7 @@ import qualified Annex.Queue
import Git.Types
import Git.FilePath
import Annex.HashObject
+import Utility.FileMode
import qualified Data.ByteString.Lazy as L
import Data.Int
@@ -118,10 +119,19 @@ hashPointerFile :: Key -> Annex Sha
hashPointerFile key = hashBlob (formatPointer key)
{- Stages a pointer file, using a Sha of its content -}
-stagePointerFile :: FilePath -> Sha -> Annex ()
-stagePointerFile file sha =
+stagePointerFile :: FilePath -> Maybe FileMode -> Sha -> Annex ()
+stagePointerFile file mode sha =
Annex.Queue.addUpdateIndex =<<
- inRepo (Git.UpdateIndex.stageFile sha FileBlob file)
+ inRepo (Git.UpdateIndex.stageFile sha blobtype file)
+ where
+ blobtype
+ | maybe False isExecutable mode = ExecutableBlob
+ | otherwise = FileBlob
+
+writePointerFile :: FilePath -> Key -> Maybe FileMode -> IO ()
+writePointerFile file k mode = do
+ writeFile file (formatPointer k)
+ maybe noop (setFileMode file) mode
{- Parses a symlink target or a pointer file to a Key.
- Only looks at the first line, as pointer files can have subsequent
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 070699cb2..d35bd79a2 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -378,7 +378,9 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
done change mcache file key = liftAnnex $ do
logStatus key InfoPresent
ifM versionSupportsUnlockedPointers
- ( stagePointerFile file =<< hashPointerFile key
+ ( do
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+ stagePointerFile file mode =<< hashPointerFile key
, do
link <- ifM isDirect
( calcRepo $ gitAnnexLink file key
diff --git a/Command/Fix.hs b/Command/Fix.hs
index d87bea358..3a153c761 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -67,7 +67,8 @@ start fixwhat file key = do
breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform
breakHardLink file key obj = do
replaceFile file $ \tmp -> do
- unlessM (checkedCopyFile key obj tmp) $
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+ unlessM (checkedCopyFile key obj tmp mode) $
error "unable to break hard link"
thawContent tmp
modifyContent obj $ freezeContent obj
@@ -77,7 +78,8 @@ breakHardLink file key obj = do
makeHardLink :: FilePath -> Key -> CommandPerform
makeHardLink file key = do
replaceFile file $ \tmp -> do
- r <- linkFromAnnex key tmp
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+ r <- linkFromAnnex key tmp mode
case r of
LinkAnnexFailed -> error "unable to make hard link"
_ -> noop
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 2e7579b5b..81618600f 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -301,12 +301,13 @@ verifyWorkTree key file = do
case mk of
Just k | k == key -> whenM (inAnnex key) $ do
showNote "fixing worktree content"
- replaceFile file $ \tmp ->
+ replaceFile file $ \tmp -> do
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
ifM (annexThin <$> Annex.getGitConfig)
- ( void $ linkFromAnnex key tmp
+ ( void $ linkFromAnnex key tmp mode
, do
obj <- calcRepo $ gitAnnexLocation key
- void $ checkedCopyFile key obj tmp
+ void $ checkedCopyFile key obj tmp mode
thawContent tmp
)
Database.Keys.storeInodeCaches key [file]
diff --git a/Command/Lock.hs b/Command/Lock.hs
index f002f016a..1cd50de7b 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -78,7 +78,7 @@ performNew file key filemodified = do
mfc <- withTSDelta (liftIO . genInodeCache file)
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
modifyContent obj $ replaceFile obj $ \tmp -> do
- unlessM (checkedCopyFile key obj tmp) $
+ unlessM (checkedCopyFile key obj tmp Nothing) $
error "unable to lock file"
Database.Keys.storeInodeCaches key [obj]
@@ -92,7 +92,7 @@ performNew file key filemodified = do
liftIO $ nukeFile obj
case mfile of
Just unmodified ->
- unlessM (checkedCopyFile key unmodified obj)
+ unlessM (checkedCopyFile key unmodified obj Nothing)
lostcontent
Nothing -> lostcontent
| otherwise = modifyContent obj $
diff --git a/Command/ReKey.hs b/Command/ReKey.hs
index 79c588ccc..4d2039530 100644
--- a/Command/ReKey.hs
+++ b/Command/ReKey.hs
@@ -61,7 +61,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
- and vulnerable to corruption. -}
( getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do
oldobj <- calcRepo (gitAnnexLocation oldkey)
- linkOrCopy' (return True) newkey oldobj tmp
+ linkOrCopy' (return True) newkey oldobj tmp Nothing
, do
ic <- withTSDelta (liftIO . genInodeCache file)
{- The file being rekeyed is itself an unlocked file, so if
@@ -69,7 +69,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
oldobj <- calcRepo (gitAnnexLocation oldkey)
v <- tryNonAsync $ modifyContent oldobj $ do
replaceFile oldobj $ \tmp ->
- unlessM (checkedCopyFile oldkey file tmp) $
+ unlessM (checkedCopyFile oldkey file tmp Nothing) $
error "can't lock old key"
freezeContent oldobj
oldic <- withTSDelta (liftIO . genInodeCache oldobj)
@@ -95,9 +95,10 @@ cleanup file oldkey newkey = do
liftIO $ removeFile file
addLink file newkey Nothing
, do
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
liftIO $ whenM (isJust <$> isPointerFile file) $
- writeFile file (formatPointer newkey)
- stagePointerFile file =<< hashPointerFile newkey
+ writePointerFile file newkey mode
+ stagePointerFile file mode =<< hashPointerFile newkey
Database.Keys.removeAssociatedFile oldkey
=<< inRepo (toTopFilePath file)
)
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index ac99d5cd3..2fe1175a8 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -15,6 +15,7 @@ import Annex.Version
import Annex.Link
import Annex.ReplaceFile
import Utility.CopyFile
+import Utility.FileMode
cmd :: Command
cmd = mkcmd "unlock" "unlock files for modification"
@@ -50,16 +51,17 @@ start file key = ifM (isJust <$> isAnnexLink file)
performNew :: FilePath -> Key -> CommandPerform
performNew dest key = do
+ destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus dest
replaceFile dest $ \tmp -> do
- r <- linkFromAnnex key tmp
+ r <- linkFromAnnex key tmp destmode
case r of
LinkAnnexOk -> return ()
_ -> error "unlock failed"
- next $ cleanupNew dest key
+ next $ cleanupNew dest key destmode
-cleanupNew :: FilePath -> Key -> CommandCleanup
-cleanupNew dest key = do
- stagePointerFile dest =<< hashPointerFile key
+cleanupNew :: FilePath -> Key -> Maybe FileMode -> CommandCleanup
+cleanupNew dest key destmode = do
+ stagePointerFile dest destmode =<< hashPointerFile key
return True
startOld :: FilePath -> Key -> CommandStart
diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs
index 08e9271a0..e5ca505ac 100644
--- a/Upgrade/V5.hs
+++ b/Upgrade/V5.hs
@@ -99,7 +99,7 @@ upgradeDirectWorkTree = do
( writepointer f k
, fromdirect f k
)
- stagePointerFile f =<< hashPointerFile k
+ stagePointerFile f Nothing =<< hashPointerFile k
Database.Keys.addAssociatedFile k
=<< inRepo (toTopFilePath f)
return ()
diff --git a/debian/changelog b/debian/changelog
index aa1deb3e4..e899ab691 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -13,6 +13,7 @@ git-annex (6.20160413) UNRELEASED; urgency=medium
* Fix bug in v6 mode that prevented treating unlocked executable files
as annexed. If you have such files, run git annex init --version=6
to update the cache after upgrading to this version of git-annex.
+ * Preserve execute bits of unlocked files in v6 mode.
-- Joey Hess <id@joeyh.name> Wed, 13 Apr 2016 13:30:32 -0400
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 19:14:46 +0000