Preserve execute bits of unlocked files in v6 mode.

When annex.thin is set, adding an object will add the execute bits to the
work tree file, and this does mean that the annex object file ends up
executable.

This doesn't add any complexity that wasn't already present, because git
annex add of an executable file has always ingested it so that the annex
object ends up executable.

But, since an annex object file can be executable or not, when populating
an unlocked file from one, the executable bit is always added or removed
to match the mode of the pointer file.

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)

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

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 ()

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

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

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

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]

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 $ 

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)
 		)

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

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 ()

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